home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / tcl / tcl70b2.lha / tcl7.0b2 / tclUnixUtil.c < prev    next >
C/C++ Source or Header  |  1993-07-08  |  31KB  |  1,142 lines
  1. /* 
  2.  * tclUnixUtil.c --
  3.  *
  4.  *    This file contains a collection of utility procedures that
  5.  *    are present in the Tcl's UNIX core but not in the generic
  6.  *    core.  For example, they do file manipulation and process
  7.  *    manipulation.
  8.  *
  9.  *    Parts of this file are based on code contributed by Karl
  10.  *    Lehenbauer, Mark Diekhans and Peter da Silva.
  11.  *
  12.  * Copyright (c) 1991-1993 The Regents of the University of California.
  13.  * All rights reserved.
  14.  *
  15.  * Permission is hereby granted, without written agreement and without
  16.  * license or royalty fees, to use, copy, modify, and distribute this
  17.  * software and its documentation for any purpose, provided that the
  18.  * above copyright notice and the following two paragraphs appear in
  19.  * all copies of this software.
  20.  * 
  21.  * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
  22.  * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
  23.  * OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
  24.  * CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  25.  *
  26.  * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
  27.  * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
  28.  * AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
  29.  * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
  30.  * PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
  31.  */
  32.  
  33. #ifndef lint
  34. static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclUnixUtil.c,v 1.36 93/07/08 09:59:25 ouster Exp $ SPRITE (Berkeley)";
  35. #endif /* not lint */
  36.  
  37. #include "tclInt.h"
  38. #include "tclUnix.h"
  39.  
  40. /*
  41.  * A linked list of the following structures is used to keep track
  42.  * of child processes that have been detached but haven't exited
  43.  * yet, so we can make sure that they're properly "reaped" (officially
  44.  * waited for) and don't lie around as zombies cluttering the
  45.  * system.
  46.  */
  47.  
  48. typedef struct Detached {
  49.     int pid;                /* Id of process that's been detached
  50.                      * but isn't known to have exited. */
  51.     struct Detached *nextPtr;        /* Next in list of all detached
  52.                      * processes. */
  53. } Detached;
  54.  
  55. static Detached *detList = NULL;    /* List of all detached proceses. */
  56.  
  57. /*
  58.  * Declarations for local procedures defined in this file:
  59.  */
  60.  
  61. static void        MakeFileTable _ANSI_ARGS_((Interp *iPtr, int index));
  62.  
  63. /*
  64.  *----------------------------------------------------------------------
  65.  *
  66.  * Tcl_EvalFile --
  67.  *
  68.  *    Read in a file and process the entire file as one gigantic
  69.  *    Tcl command.
  70.  *
  71.  * Results:
  72.  *    A standard Tcl result, which is either the result of executing
  73.  *    the file or an error indicating why the file couldn't be read.
  74.  *
  75.  * Side effects:
  76.  *    Depends on the commands in the file.
  77.  *
  78.  *----------------------------------------------------------------------
  79.  */
  80.  
  81. int
  82. Tcl_EvalFile(interp, fileName)
  83.     Tcl_Interp *interp;        /* Interpreter in which to process file. */
  84.     char *fileName;        /* Name of file to process.  Tilde-substitution
  85.                  * will be performed on this name. */
  86. {
  87.     int fileId, result;
  88.     struct stat statBuf;
  89.     char *cmdBuffer, *oldScriptFile;
  90.     Interp *iPtr = (Interp *) interp;
  91.     Tcl_DString buffer;
  92.  
  93.     oldScriptFile = iPtr->scriptFile;
  94.     iPtr->scriptFile = fileName;
  95.     fileName = Tcl_TildeSubst(interp, fileName, &buffer);
  96.     if (fileName == NULL) {
  97.     goto error;
  98.     }
  99.     fileId = open(fileName, O_RDONLY, 0);
  100.     if (fileId < 0) {
  101.     Tcl_AppendResult(interp, "couldn't read file \"", fileName,
  102.         "\": ", Tcl_PosixError(interp), (char *) NULL);
  103.     goto error;
  104.     }
  105.     if (fstat(fileId, &statBuf) == -1) {
  106.     Tcl_AppendResult(interp, "couldn't stat file \"", fileName,
  107.         "\": ", Tcl_PosixError(interp), (char *) NULL);
  108.     close(fileId);
  109.     goto error;
  110.     }
  111.     cmdBuffer = (char *) ckalloc((unsigned) statBuf.st_size+1);
  112.     if (read(fileId, cmdBuffer, (size_t) statBuf.st_size) != statBuf.st_size) {
  113.     Tcl_AppendResult(interp, "error in reading file \"", fileName,
  114.         "\": ", Tcl_PosixError(interp), (char *) NULL);
  115.     close(fileId);
  116.     ckfree(cmdBuffer);
  117.     goto error;
  118.     }
  119.     if (close(fileId) != 0) {
  120.     Tcl_AppendResult(interp, "error closing file \"", fileName,
  121.         "\": ", Tcl_PosixError(interp), (char *) NULL);
  122.     ckfree(cmdBuffer);
  123.     goto error;
  124.     }
  125.     cmdBuffer[statBuf.st_size] = 0;
  126.     result = Tcl_Eval(interp, cmdBuffer);
  127.     if (result == TCL_RETURN) {
  128.     result = TCL_OK;
  129.     }
  130.     if (result == TCL_ERROR) {
  131.     char msg[200];
  132.  
  133.     /*
  134.      * Record information telling where the error occurred.
  135.      */
  136.  
  137.     sprintf(msg, "\n    (file \"%.150s\" line %d)", fileName,
  138.         interp->errorLine);
  139.     Tcl_AddErrorInfo(interp, msg);
  140.     }
  141.     ckfree(cmdBuffer);
  142.     iPtr->scriptFile = oldScriptFile;
  143.     Tcl_DStringFree(&buffer);
  144.     return result;
  145.  
  146.     error:
  147.     iPtr->scriptFile = oldScriptFile;
  148.     Tcl_DStringFree(&buffer);
  149.     return TCL_ERROR;
  150. }
  151.  
  152. /*
  153.  *----------------------------------------------------------------------
  154.  *
  155.  * Tcl_DetachPids --
  156.  *
  157.  *    This procedure is called to indicate that one or more child
  158.  *    processes have been placed in background and will never be
  159.  *    waited for;  they should eventually be reaped by
  160.  *    Tcl_ReapDetachedProcs.
  161.  *
  162.  * Results:
  163.  *    None.
  164.  *
  165.  * Side effects:
  166.  *    None.
  167.  *
  168.  *----------------------------------------------------------------------
  169.  */
  170.  
  171. void
  172. Tcl_DetachPids(numPids, pidPtr)
  173.     int numPids;        /* Number of pids to detach:  gives size
  174.                  * of array pointed to by pidPtr. */
  175.     int *pidPtr;        /* Array of pids to detach. */
  176. {
  177.     register Detached *detPtr;
  178.     int i;
  179.  
  180.     for (i = 0; i < numPids; i++) {
  181.     detPtr = (Detached *) ckalloc(sizeof(Detached));
  182.     detPtr->pid = pidPtr[i];
  183.     detPtr->nextPtr = detList;
  184.     detList = detPtr;
  185.     }
  186. }
  187.  
  188. /*
  189.  *----------------------------------------------------------------------
  190.  *
  191.  * Tcl_ReapDetachedProcs --
  192.  *
  193.  *    This procedure checks to see if any detached processes have
  194.  *    exited and, if so, it "reaps" them by officially waiting on
  195.  *    them.  It should be called "occasionally" to make sure that
  196.  *    all detached processes are eventually reaped.
  197.  *
  198.  * Results:
  199.  *    None.
  200.  *
  201.  * Side effects:
  202.  *    Processes are waited on, so that they can be reaped by the
  203.  *    system.
  204.  *
  205.  *----------------------------------------------------------------------
  206.  */
  207.  
  208. void
  209. Tcl_ReapDetachedProcs()
  210. {
  211.     register Detached *detPtr;
  212.     Detached *nextPtr, *prevPtr;
  213.     int status, result;
  214.  
  215.     for (detPtr = detList, prevPtr = NULL; detPtr != NULL; ) {
  216.     result = waitpid(detPtr->pid, &status, WNOHANG);
  217.     if ((result == 0) || ((result == -1) && (errno != ECHILD))) {
  218.         prevPtr = detPtr;
  219.         detPtr = detPtr->nextPtr;
  220.         continue;
  221.     }
  222.     nextPtr = detPtr->nextPtr;
  223.     if (prevPtr == NULL) {
  224.         detList = detPtr->nextPtr;
  225.     } else {
  226.         prevPtr->nextPtr = detPtr->nextPtr;
  227.     }
  228.     ckfree((char *) detPtr);
  229.     detPtr = nextPtr;
  230.     }
  231. }
  232.  
  233. /*
  234.  *----------------------------------------------------------------------
  235.  *
  236.  * Tcl_CreatePipeline --
  237.  *
  238.  *    Given an argc/argv array, instantiate a pipeline of processes
  239.  *    as described by the argv.
  240.  *
  241.  * Results:
  242.  *    The return value is a count of the number of new processes
  243.  *    created, or -1 if an error occurred while creating the pipeline.
  244.  *    *pidArrayPtr is filled in with the address of a dynamically
  245.  *    allocated array giving the ids of all of the processes.  It
  246.  *    is up to the caller to free this array when it isn't needed
  247.  *    anymore.  If inPipePtr is non-NULL, *inPipePtr is filled in
  248.  *    with the file id for the input pipe for the pipeline (if any):
  249.  *    the caller must eventually close this file.  If outPipePtr
  250.  *    isn't NULL, then *outPipePtr is filled in with the file id
  251.  *    for the output pipe from the pipeline:  the caller must close
  252.  *    this file.  If errFilePtr isn't NULL, then *errFilePtr is filled
  253.  *    with a file id that may be used to read error output after the
  254.  *    pipeline completes.
  255.  *
  256.  * Side effects:
  257.  *    Processes and pipes are created.
  258.  *
  259.  *----------------------------------------------------------------------
  260.  */
  261.  
  262. int
  263. Tcl_CreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
  264.     outPipePtr, errFilePtr)
  265.     Tcl_Interp *interp;        /* Interpreter to use for error reporting. */
  266.     int argc;            /* Number of entries in argv. */
  267.     char **argv;        /* Array of strings describing commands in
  268.                  * pipeline plus I/O redirection with <,
  269.                  * <<,  >, etc.  Argv[argc] must be NULL. */
  270.     int **pidArrayPtr;        /* Word at *pidArrayPtr gets filled in with
  271.                  * address of array of pids for processes
  272.                  * in pipeline (first pid is first process
  273.                  * in pipeline). */
  274.     int *inPipePtr;        /* If non-NULL, input to the pipeline comes
  275.                  * from a pipe (unless overridden by
  276.                  * redirection in the command).  The file
  277.                  * id with which to write to this pipe is
  278.                  * stored at *inPipePtr.  -1 means command
  279.                  * specified its own input source. */
  280.     int *outPipePtr;        /* If non-NULL, output to the pipeline goes
  281.                  * to a pipe, unless overriden by redirection
  282.                  * in the command.  The file id with which to
  283.                  * read frome this pipe is stored at
  284.                  * *outPipePtr.  -1 means command specified
  285.                  * its own output sink. */
  286.     int *errFilePtr;        /* If non-NULL, all stderr output from the
  287.                  * pipeline will go to a temporary file
  288.                  * created here, and a descriptor to read
  289.                  * the file will be left at *errFilePtr.
  290.                  * The file will be removed already, so
  291.                  * closing this descriptor will be the end
  292.                  * of the file.  If this is NULL, then
  293.                  * all stderr output goes to our stderr.
  294.                  * If the pipeline specifies redirection
  295.                  * then the fill will still be created
  296.                  * but it will never get any data. */
  297. {
  298.     int *pidPtr = NULL;        /* Points to malloc-ed array holding all
  299.                  * the pids of child processes. */
  300.     int numPids = 0;        /* Actual number of processes that exist
  301.                  * at *pidPtr right now. */
  302.     int cmdCount;        /* Count of number of distinct commands
  303.                  * found in argc/argv. */
  304.     char *input = NULL;        /* If non-null, then this points to a
  305.                  * string containing input data (specified
  306.                  * via <<) to be piped to the first process
  307.                  * in the pipeline. */
  308.     int inputId = -1;        /* If >= 0, gives file id to use as input for
  309.                  * first process in pipeline (specified via
  310.                  * < or <@). */
  311.     int closeInput = 0;        /* If non-zero, then must close inputId
  312.                  * when cleaning up (zero means the file needs
  313.                  * to stay open for some other reason). */
  314.     int outputId = -1;        /* Writable file id for output from last
  315.                  * command in pipeline (could be file or pipe).
  316.                  * -1 means use stdout. */
  317.     int closeOutput = 0;    /* Non-zero means must close outputId when
  318.                  * cleaning up (similar to closeInput). */
  319.     int errorId = -1;        /* Writable file id for error output from
  320.                  * all commands in pipeline. -1 means use
  321.                  * stderr. */
  322.     int closeError = 0;        /* Non-zero means must close errorId when
  323.                  * cleaning up. */
  324.     int pipeIds[2];        /* File ids for pipe that's being created. */
  325.     int firstArg, lastArg;    /* Indexes of first and last arguments in
  326.                  * current command. */
  327.     int skip;            /* Number of arguments to skip (because they
  328.                  * specify redirection). */
  329.     FILE *f;
  330.     int lastBar;
  331.     char *execName;
  332.     int i, j, pid;
  333.     char *p;
  334.     Tcl_DString buffer;
  335.  
  336.     if (inPipePtr != NULL) {
  337.     *inPipePtr = -1;
  338.     }
  339.     if (outPipePtr != NULL) {
  340.     *outPipePtr = -1;
  341.     }
  342.     if (errFilePtr != NULL) {
  343.     *errFilePtr = -1;
  344.     }
  345.     pipeIds[0] = pipeIds[1] = -1;
  346.  
  347.     /*
  348.      * First, scan through all the arguments to figure out the structure
  349.      * of the pipeline.  Process all of the input and output redirection
  350.      * arguments and remove them from the argument list in the pipeline.
  351.      * Count the number of distinct processes (it's the number of "|"
  352.      * arguments plus one) but don't remove the "|" arguments.
  353.      */
  354.  
  355.     cmdCount = 1;
  356.     lastBar = -1;
  357.     for (i = 0; i < argc; i++) {
  358.     if ((argv[i][0] == '|') && (((argv[i][1] == 0))
  359.         || ((argv[i][1] == '&') && (argv[i][2] == 0)))) {
  360.         if ((i == (lastBar+1)) || (i == (argc-1))) {
  361.         interp->result = "illegal use of | or |& in command";
  362.         return -1;
  363.         }
  364.         lastBar = i;
  365.         cmdCount++;
  366.         continue;
  367.     } else if (argv[i][0] == '<') {
  368.         if ((inputId >= 0) && closeInput) {
  369.         close(inputId);
  370.         }
  371.         inputId = -1;
  372.         skip = 1;
  373.         if (argv[i][1] == '<') {
  374.         input = argv[i]+2;
  375.         if (*input == 0) {
  376.             input = argv[i+1];
  377.             if (input == 0) {
  378.             badLastArg:
  379.             Tcl_AppendResult(interp, "can't specify \"", argv[i],
  380.                 "\" as last word in command", (char *) NULL);
  381.             goto error;
  382.             }
  383.             skip = 2;
  384.         }
  385.         } else {
  386.         input = 0;
  387.         p = argv[i] + 1;
  388.         if (*p == '@') {
  389.             p++;
  390.             if (*p == 0) {
  391.             p = argv[i+1];
  392.             if (p == NULL) {
  393.                 goto badLastArg;
  394.             }
  395.             skip = 2;
  396.             }
  397.             if (Tcl_GetOpenFile(interp, p, 0, 1, &f) != TCL_OK) {
  398.             goto error;
  399.             }
  400.             inputId = fileno(f);
  401.             closeInput = 0;
  402.         } else {
  403.             if (*p == 0) {
  404.             p = argv[i+1];
  405.             if (p == NULL) {
  406.                 goto badLastArg;
  407.             }
  408.             skip = 2;
  409.             }
  410.             inputId = open(p, O_RDONLY, 0);
  411.             closeInput = 1;
  412.             if (inputId < 0) {
  413.             Tcl_AppendResult(interp,
  414.                 "couldn't read file \"", p, "\": ",
  415.                 Tcl_PosixError(interp), (char *) NULL);
  416.             goto error;
  417.             }
  418.         }
  419.         }
  420.     } else if (argv[i][0] == '>') {
  421.         int append, useForStdErr, useForStdOut, mustClose, fd;
  422.  
  423.         skip = 1;
  424.         append = useForStdErr = 0;
  425.         useForStdOut = 1;
  426.         if (argv[i][1] == '>') {
  427.         p = argv[i] + 2;
  428.         append = 1;
  429.         } else {
  430.         p = argv[i] + 1;
  431.         }
  432.         if (*p == '&') {
  433.         useForStdErr = 1;
  434.         p++;
  435.         } else if (*p == '2') {
  436.         useForStdErr = 1;
  437.         useForStdOut = 0;
  438.         p++;
  439.         }
  440.         if (*p == '@') {
  441.         p++;
  442.         if (*p == 0) {
  443.             p = argv[i+1];
  444.             if (p == NULL) {
  445.             goto badLastArg;
  446.             }
  447.             skip = 2;
  448.         }
  449.         if (Tcl_GetOpenFile(interp, p, 1, 1, &f) != TCL_OK) {
  450.             goto error;
  451.         }
  452.         fd = fileno(f);
  453.         mustClose = 0;
  454.         } else {
  455.         if (*p == 0) {
  456.             p = argv[i+1];
  457.             if (p == NULL) {
  458.             goto badLastArg;
  459.             }
  460.             skip = 2;
  461.         }
  462.         if (!append) {
  463.             fd = open(p, O_WRONLY|O_CREAT|O_TRUNC, 0666);
  464.         } else {
  465.             fd = open(p, O_WRONLY|O_CREAT, 0666);
  466.             if (fd >= 0) {
  467.             lseek(fd, 0L, 2);
  468.             }
  469.         }
  470.         if (fd < 0) {
  471.             Tcl_AppendResult(interp,
  472.                 "couldn't write file \"", p, "\": ",
  473.                 Tcl_PosixError(interp), (char *) NULL);
  474.             goto error;
  475.         }
  476.         mustClose = 1;
  477.         }
  478.  
  479.         /*
  480.          * Got the file descriptor.  Now use it for standard output,
  481.          * standard error, or both, depending on the redirection.
  482.          */
  483.  
  484.         if (useForStdOut) {
  485.         if ((outputId > 0) && closeOutput) {
  486.             close(outputId);
  487.         }
  488.         outputId = fd;
  489.         closeOutput = mustClose;
  490.         }
  491.         if (useForStdErr) {
  492.         if ((errorId > 0) && closeError) {
  493.             close(errorId);
  494.         }
  495.         errorId = fd;
  496.         closeError = (useForStdOut) ? 0 : mustClose;
  497.         }
  498.     } else {
  499.         continue;
  500.     }
  501.     for (j = i+skip; j < argc; j++) {
  502.         argv[j-skip] = argv[j];
  503.     }
  504.     argc -= skip;
  505.     i -= 1;            /* Process next arg from same position. */
  506.     }
  507.     if (argc == 0) {
  508.     interp->result =  "didn't specify command to execute";
  509.     return -1;
  510.     }
  511.  
  512.     if (inputId < 0) {
  513.     if (input != NULL) {
  514.         char inName[L_tmpnam];
  515.         int length;
  516.  
  517.         /*
  518.          * The input for the first process is immediate data coming from
  519.          * Tcl.  Create a temporary file for it and put the data into the
  520.          * file.
  521.          */
  522.  
  523.         tmpnam(inName);
  524.         inputId = open(inName, O_RDWR|O_CREAT|O_TRUNC, 0600);
  525.         closeInput = 1;
  526.         if (inputId < 0) {
  527.         Tcl_AppendResult(interp,
  528.             "couldn't create input file for command: ",
  529.             Tcl_PosixError(interp), (char *) NULL);
  530.         goto error;
  531.         }
  532.         length = strlen(input);
  533.         if (write(inputId, input, (size_t) length) != length) {
  534.         Tcl_AppendResult(interp,
  535.             "couldn't write file input for command: ",
  536.             Tcl_PosixError(interp), (char *) NULL);
  537.         goto error;
  538.         }
  539.         if ((lseek(inputId, 0L, 0) == -1) || (unlink(inName) == -1)) {
  540.         Tcl_AppendResult(interp,
  541.             "couldn't reset or remove input file for command: ",
  542.             Tcl_PosixError(interp), (char *) NULL);
  543.         goto error;
  544.         }
  545.     } else if (inPipePtr != NULL) {
  546.         /*
  547.          * The input for the first process in the pipeline is to
  548.          * come from a pipe that can be written from this end.
  549.          */
  550.  
  551.         if (pipe(pipeIds) != 0) {
  552.         Tcl_AppendResult(interp,
  553.             "couldn't create input pipe for command: ",
  554.             Tcl_PosixError(interp), (char *) NULL);
  555.         goto error;
  556.         }
  557.         inputId = pipeIds[0];
  558.         closeInput = 1;
  559.         *inPipePtr = pipeIds[1];
  560.         pipeIds[0] = pipeIds[1] = -1;
  561.     }
  562.     }
  563.  
  564.     /*
  565.      * Set up a pipe to receive output from the pipeline, if no other
  566.      * output sink has been specified.
  567.      */
  568.  
  569.     if ((outputId < 0) && (outPipePtr != NULL)) {
  570.     if (pipe(pipeIds) != 0) {
  571.         Tcl_AppendResult(interp,
  572.             "couldn't create output pipe: ",
  573.             Tcl_PosixError(interp), (char *) NULL);
  574.         goto error;
  575.     }
  576.     outputId = pipeIds[1];
  577.     closeOutput = 1;
  578.     *outPipePtr = pipeIds[0];
  579.     pipeIds[0] = pipeIds[1] = -1;
  580.     }
  581.  
  582.     /*
  583.      * Set up the standard error output sink for the pipeline, if
  584.      * requested.  Use a temporary file which is opened, then deleted.
  585.      * Could potentially just use pipe, but if it filled up it could
  586.      * cause the pipeline to deadlock:  we'd be waiting for processes
  587.      * to complete before reading stderr, and processes couldn't complete
  588.      * because stderr was backed up.
  589.      */
  590.  
  591.     if (errFilePtr != NULL) {
  592.     char errName[L_tmpnam];
  593.  
  594.     tmpnam(errName);
  595.     *errFilePtr = open(errName, O_RDONLY|O_CREAT|O_TRUNC, 0600);
  596.     if (*errFilePtr < 0) {
  597.         errFileError:
  598.         Tcl_AppendResult(interp,
  599.             "couldn't create error file for command: ",
  600.             Tcl_PosixError(interp), (char *) NULL);
  601.         goto error;
  602.     }
  603.     if (errorId < 0) {
  604.         errorId = open(errName, O_WRONLY|O_CREAT|O_TRUNC, 0600);
  605.         if (errorId < 0) {
  606.         goto errFileError;
  607.         }
  608.         closeError = 1;
  609.     }
  610.     if (unlink(errName) == -1) {
  611.         Tcl_AppendResult(interp,
  612.             "couldn't remove error file for command: ",
  613.             Tcl_PosixError(interp), (char *) NULL);
  614.         goto error;
  615.     }
  616.     }
  617.  
  618.     /*
  619.      * Scan through the argc array, forking off a process for each
  620.      * group of arguments between "|" arguments.
  621.      */
  622.  
  623.     pidPtr = (int *) ckalloc((unsigned) (cmdCount * sizeof(int)));
  624.     for (i = 0; i < numPids; i++) {
  625.     pidPtr[i] = -1;
  626.     }
  627.     Tcl_ReapDetachedProcs();
  628.     for (firstArg = 0; firstArg < argc; numPids++, firstArg = lastArg+1) {
  629.     int joinThisError;
  630.     int curOutputId;
  631.  
  632.     joinThisError = 0;
  633.     for (lastArg = firstArg; lastArg < argc; lastArg++) {
  634.         if (argv[lastArg][0] == '|') {
  635.         if (argv[lastArg][1] == 0) {
  636.             break;
  637.         }
  638.         if ((argv[lastArg][1] == '&') && (argv[lastArg][2] == 0)) {
  639.             joinThisError = 1;
  640.             break;
  641.         }
  642.         }
  643.     }
  644.     argv[lastArg] = NULL;
  645.     if (lastArg == argc) {
  646.         curOutputId = outputId;
  647.     } else {
  648.         if (pipe(pipeIds) != 0) {
  649.         Tcl_AppendResult(interp, "couldn't create pipe: ",
  650.             Tcl_PosixError(interp), (char *) NULL);
  651.         goto error;
  652.         }
  653.         curOutputId = pipeIds[1];
  654.     }
  655.     execName = Tcl_TildeSubst(interp, argv[firstArg], &buffer);
  656.     pid = fork();
  657.     if (pid == 0) {
  658.         char errSpace[200];
  659.  
  660.         if (((inputId != -1) && (dup2(inputId, 0) == -1))
  661.             || ((curOutputId != -1) && (dup2(curOutputId, 1) == -1))
  662.             || (joinThisError && (dup2(1, 2) == -1))
  663.             || (!joinThisError && (errorId != -1)
  664.                 && (dup2(errorId, 2) == -1))) {
  665.         char *err;
  666.         err = "forked process couldn't set up input/output\n";
  667.         write(errorId < 0 ? 2 : errorId, err, (size_t) strlen(err));
  668.         _exit(1);
  669.         }
  670.         for (i = 3; (i <= curOutputId) || (i <= inputId)
  671.             || (i <= outputId) || (i <= errorId); i++) {
  672.         close(i);
  673.         }
  674.         execvp(execName, &argv[firstArg]);
  675.         sprintf(errSpace, "couldn't find \"%.150s\" to execute\n",
  676.             argv[firstArg]);
  677.         write(2, errSpace, (size_t) strlen(errSpace));
  678.         _exit(1);
  679.     }
  680.     Tcl_DStringFree(&buffer);
  681.     if (pid == -1) {
  682.         Tcl_AppendResult(interp, "couldn't fork child process: ",
  683.             Tcl_PosixError(interp), (char *) NULL);
  684.         goto error;
  685.     }
  686.     pidPtr[numPids] = pid;
  687.  
  688.     /*
  689.      * Close off our copies of file descriptors that were set up for
  690.      * this child, then set up the input for the next child.
  691.      */
  692.  
  693.     if ((inputId != -1) && closeInput) {
  694.         close(inputId);
  695.     }
  696.     if ((curOutputId != -1) && (curOutputId != outputId)) {
  697.         close(curOutputId);
  698.     }
  699.     inputId = pipeIds[0];
  700.     closeInput = 1;
  701.     pipeIds[0] = pipeIds[1] = -1;
  702.     }
  703.     *pidArrayPtr = pidPtr;
  704.  
  705.     /*
  706.      * All done.  Cleanup open files lying around and then return.
  707.      */
  708.  
  709. cleanup:
  710.     if ((inputId != -1) && closeInput) {
  711.     close(inputId);
  712.     }
  713.     if ((outputId != -1) && closeOutput) {
  714.     close(outputId);
  715.     }
  716.     if ((errorId != -1) && closeError) {
  717.     close(errorId);
  718.     }
  719.     return numPids;
  720.  
  721.     /*
  722.      * An error occurred.  There could have been extra files open, such
  723.      * as pipes between children.  Clean them all up.  Detach any child
  724.      * processes that have been created.
  725.      */
  726.  
  727.     error:
  728.     if ((inPipePtr != NULL) && (*inPipePtr != -1)) {
  729.     close(*inPipePtr);
  730.     *inPipePtr = -1;
  731.     }
  732.     if ((outPipePtr != NULL) && (*outPipePtr != -1)) {
  733.     close(*outPipePtr);
  734.     *outPipePtr = -1;
  735.     }
  736.     if ((errFilePtr != NULL) && (*errFilePtr != -1)) {
  737.     close(*errFilePtr);
  738.     *errFilePtr = -1;
  739.     }
  740.     if (pipeIds[0] != -1) {
  741.     close(pipeIds[0]);
  742.     }
  743.     if (pipeIds[1] != -1) {
  744.     close(pipeIds[1]);
  745.     }
  746.     if (pidPtr != NULL) {
  747.     for (i = 0; i < numPids; i++) {
  748.         if (pidPtr[i] != -1) {
  749.         Tcl_DetachPids(1, &pidPtr[i]);
  750.         }
  751.     }
  752.     ckfree((char *) pidPtr);
  753.     }
  754.     numPids = -1;
  755.     goto cleanup;
  756. }
  757.  
  758. /*
  759.  *----------------------------------------------------------------------
  760.  *
  761.  * Tcl_PosixError --
  762.  *
  763.  *    This procedure is typically called after UNIX kernel calls
  764.  *    return errors.  It stores machine-readable information about
  765.  *    the error in $errorCode returns an information string for
  766.  *    the caller's use.
  767.  *
  768.  * Results:
  769.  *    The return value is a human-readable string describing the
  770.  *    error, as returned by strerror.
  771.  *
  772.  * Side effects:
  773.  *    The global variable $errorCode is reset.
  774.  *
  775.  *----------------------------------------------------------------------
  776.  */
  777.  
  778. char *
  779. Tcl_PosixError(interp)
  780.     Tcl_Interp *interp;        /* Interpreter whose $errorCode variable
  781.                  * is to be changed. */
  782. {
  783.     char *id, *msg;
  784.  
  785.     id = Tcl_ErrnoId();
  786.     msg = strerror(errno);
  787.     Tcl_SetErrorCode(interp, "POSIX", id, msg, (char *) NULL);
  788.     return msg;
  789. }
  790.  
  791. /*
  792.  *----------------------------------------------------------------------
  793.  *
  794.  * MakeFileTable --
  795.  *
  796.  *    Create or enlarge the file table for the interpreter, so that
  797.  *    there is room for a given index.
  798.  *
  799.  * Results:
  800.  *    None.
  801.  *
  802.  * Side effects:
  803.  *    The file table for iPtr will be created if it doesn't exist
  804.  *    (and entries will be added for stdin, stdout, and stderr).
  805.  *    If it already exists, then it will be grown if necessary.
  806.  *
  807.  *----------------------------------------------------------------------
  808.  */
  809.  
  810. static void
  811. MakeFileTable(iPtr, index)
  812.     Interp *iPtr;        /* Interpreter whose table of files is
  813.                  * to be manipulated. */
  814.     int index;            /* Make sure table is large enough to
  815.                  * hold at least this index. */
  816. {
  817.     /*
  818.      * If the table doesn't even exist, then create it and initialize
  819.      * entries for standard files.
  820.      */
  821.  
  822.     if (iPtr->numFiles == 0) {
  823.     OpenFile *oFilePtr;
  824.     int i;
  825.  
  826.     if (index < 2) {
  827.         iPtr->numFiles = 3;
  828.     } else {
  829.         iPtr->numFiles = index+1;
  830.     }
  831.     iPtr->oFilePtrArray = (OpenFile **) ckalloc((unsigned)
  832.         ((iPtr->numFiles)*sizeof(OpenFile *)));
  833.     for (i = iPtr->numFiles-1; i >= 0; i--) {
  834.         iPtr->oFilePtrArray[i] = NULL;
  835.     }
  836.  
  837.     oFilePtr = (OpenFile *) ckalloc(sizeof(OpenFile));
  838.     oFilePtr->f = stdin;
  839.     oFilePtr->f2 = NULL;
  840.     oFilePtr->readable = 1;
  841.     oFilePtr->writable = 0;
  842.     oFilePtr->numPids = 0;
  843.     oFilePtr->pidPtr = NULL;
  844.     oFilePtr->errorId = -1;
  845.     iPtr->oFilePtrArray[0] = oFilePtr;
  846.  
  847.     oFilePtr = (OpenFile *) ckalloc(sizeof(OpenFile));
  848.     oFilePtr->f = stdout;
  849.     oFilePtr->f2 = NULL;
  850.     oFilePtr->readable = 0;
  851.     oFilePtr->writable = 1;
  852.     oFilePtr->numPids = 0;
  853.     oFilePtr->pidPtr = NULL;
  854.     oFilePtr->errorId = -1;
  855.     iPtr->oFilePtrArray[1] = oFilePtr;
  856.  
  857.     oFilePtr = (OpenFile *) ckalloc(sizeof(OpenFile));
  858.     oFilePtr->f = stderr;
  859.     oFilePtr->f2 = NULL;
  860.     oFilePtr->readable = 0;
  861.     oFilePtr->writable = 1;
  862.     oFilePtr->numPids = 0;
  863.     oFilePtr->pidPtr = NULL;
  864.     oFilePtr->errorId = -1;
  865.     iPtr->oFilePtrArray[2] = oFilePtr;
  866.     } else if (index >= iPtr->numFiles) {
  867.     int newSize;
  868.     OpenFile **newPtrArray;
  869.     int i;
  870.  
  871.     newSize = index+1;
  872.     newPtrArray = (OpenFile **) ckalloc((unsigned)
  873.         ((newSize)*sizeof(OpenFile *)));
  874.     memcpy((VOID *) newPtrArray, (VOID *) iPtr->oFilePtrArray,
  875.         iPtr->numFiles*sizeof(OpenFile *));
  876.     for (i = iPtr->numFiles; i < newSize; i++) {
  877.         newPtrArray[i] = NULL;
  878.     }
  879.     ckfree((char *) iPtr->oFilePtrArray);
  880.     iPtr->numFiles = newSize;
  881.     iPtr->oFilePtrArray = newPtrArray;
  882.     }
  883. }
  884.  
  885. /*
  886.  *----------------------------------------------------------------------
  887.  *
  888.  * Tcl_EnterFile --
  889.  *
  890.  *    This procedure is used to enter an already-open file into the
  891.  *    file table for an interpreter so that the file can be read
  892.  *    and written with Tcl commands.
  893.  *
  894.  * Results:
  895.  *    There is no return value, but interp->result is set to
  896.  *    hold Tcl's id for the open file, such as "file4".
  897.  *
  898.  * Side effects:
  899.  *    "File" is added to the files accessible from interp.
  900.  *
  901.  *----------------------------------------------------------------------
  902.  */
  903.  
  904. void
  905. Tcl_EnterFile(interp, file, readable, writable)
  906.     Tcl_Interp *interp;        /* Interpreter in which to make file
  907.                  * available. */
  908.     FILE *file;            /* File to make available in interp. */
  909.     int readable;        /* Non-zero means it's OK to read file. */
  910.     int writable;        /* Non-zero means it's OK to write file. */
  911. {
  912.     Interp *iPtr = (Interp *) interp;
  913.     int fd;
  914.     register OpenFile *oFilePtr;
  915.  
  916.     fd = fileno(file);
  917.     if (fd >= iPtr->numFiles) {
  918.     MakeFileTable(iPtr, fd);
  919.     }
  920.     oFilePtr = iPtr->oFilePtrArray[fd];
  921.  
  922.     /*
  923.      * It's possible that there already appears to be a file open in
  924.      * the slot.  This could happen, for example, if the application
  925.      * closes a file behind our back so that we don't have a chance
  926.      * to clean up.  This is probably a bad idea, but if it happens
  927.      * just discard the information in the old record (hopefully the
  928.      * application is smart enough to have really cleaned everything
  929.      * up right).
  930.      */
  931.  
  932.     if (oFilePtr == NULL) {
  933.     oFilePtr = (OpenFile *) ckalloc(sizeof(OpenFile));
  934.     iPtr->oFilePtrArray[fd] = oFilePtr;
  935.     }
  936.     oFilePtr->f = file;
  937.     oFilePtr->f2 = NULL;
  938.     oFilePtr->readable = readable;
  939.     oFilePtr->writable = writable;
  940.     oFilePtr->numPids = 0;
  941.     oFilePtr->pidPtr = NULL;
  942.     oFilePtr->errorId = -1;
  943.     if (fd <= 2) {
  944.     if (fd == 0) {
  945.         interp->result = "stdin";
  946.     } else if (fd == 1) {
  947.         interp->result = "stdout";
  948.     } else {
  949.         interp->result = "stderr";
  950.     }
  951.     } else {
  952.     sprintf(interp->result, "file%d", fd);
  953.     }
  954. }
  955.  
  956. /*
  957.  *----------------------------------------------------------------------
  958.  *
  959.  * Tcl_GetOpenFile --
  960.  *
  961.  *    Given a string identifier for an open file, find the corresponding
  962.  *    open file structure, if there is one.
  963.  *
  964.  * Results:
  965.  *    A standard Tcl return value.  If the open file is successfully
  966.  *    located and meets any usage check requested by checkUsage, TCL_OK
  967.  *    is returned and *filePtr is modified to hold a pointer to its
  968.  *    FILE structure.  If an error occurs then TCL_ERROR is returned
  969.  *    and interp->result contains an error message.
  970.  *
  971.  * Side effects:
  972.  *    None.
  973.  *
  974.  *----------------------------------------------------------------------
  975.  */
  976.  
  977. int
  978. Tcl_GetOpenFile(interp, string, forWriting, checkUsage, filePtr)
  979.     Tcl_Interp *interp;        /* Interpreter in which to find file. */
  980.     char *string;        /* String that identifies file. */
  981.     int forWriting;        /* 1 means the file is going to be used
  982.                  * for writing, 0 means for reading. */
  983.     int checkUsage;        /* 1 means verify that the file was opened
  984.                  * in a mode that allows the access specified
  985.                  * by "forWriting". */
  986.     FILE **filePtr;        /* Store pointer to FILE structure here. */
  987. {
  988.     OpenFile *oFilePtr;
  989.     int fd = 0;            /* Initial value needed only to stop compiler
  990.                  * warnings. */
  991.     Interp *iPtr = (Interp *) interp;
  992.  
  993.     if ((string[0] == 'f') && (string[1] == 'i') && (string[2] == 'l')
  994.         & (string[3] == 'e')) {
  995.     char *end;
  996.  
  997.     fd = strtoul(string+4, &end, 10);
  998.     if ((end == string+4) || (*end != 0)) {
  999.         goto badId;
  1000.     }
  1001.     } else if ((string[0] == 's') && (string[1] == 't')
  1002.         && (string[2] == 'd')) {
  1003.     if (strcmp(string+3, "in") == 0) {
  1004.         fd = 0;
  1005.     } else if (strcmp(string+3, "out") == 0) {
  1006.         fd = 1;
  1007.     } else if (strcmp(string+3, "err") == 0) {
  1008.         fd = 2;
  1009.     } else {
  1010.         goto badId;
  1011.     }
  1012.     } else {
  1013.     badId:
  1014.     Tcl_AppendResult(interp, "bad file identifier \"", string,
  1015.         "\"", (char *) NULL);
  1016.     return TCL_ERROR;
  1017.     }
  1018.  
  1019.     if (fd >= iPtr->numFiles) {
  1020.     if ((iPtr->numFiles == 0) && (fd <= 2)) {
  1021.         MakeFileTable(iPtr, fd);
  1022.     } else {
  1023.         notOpen:
  1024.         Tcl_AppendResult(interp, "file \"", string, "\" isn't open",
  1025.             (char *) NULL);
  1026.         return TCL_ERROR;
  1027.     }
  1028.     }
  1029.     oFilePtr = iPtr->oFilePtrArray[fd];
  1030.     if (oFilePtr == NULL) {
  1031.     goto notOpen;
  1032.     }
  1033.     if (forWriting) {
  1034.     if (checkUsage && !oFilePtr->writable) {
  1035.         Tcl_AppendResult(interp, "\"", string,
  1036.             "\" wasn't opened for writing", (char *) NULL);
  1037.         return TCL_ERROR;
  1038.     }
  1039.     if (oFilePtr->f2 != NULL) {
  1040.         *filePtr = oFilePtr->f2;
  1041.     } else {
  1042.         *filePtr = oFilePtr->f;
  1043.     }
  1044.     } else {
  1045.     if (checkUsage && !oFilePtr->readable) {
  1046.         Tcl_AppendResult(interp, "\"", string,
  1047.             "\" wasn't opened for reading", (char *) NULL);
  1048.         return TCL_ERROR;
  1049.     }
  1050.     *filePtr = oFilePtr->f;
  1051.     }
  1052.     return TCL_OK;
  1053. }
  1054.  
  1055. /*
  1056.  *----------------------------------------------------------------------
  1057.  *
  1058.  * TclOpen, etc. --
  1059.  *
  1060.  *    Below are a bunch of procedures that are used by Tcl instead
  1061.  *    of system calls.  Each of the procedures executes the
  1062.  *    corresponding system call and retries automatically
  1063.  *    if the system call was interrupted by a signal.
  1064.  *
  1065.  * Results:
  1066.  *    Whatever the system call would normally return.
  1067.  *
  1068.  * Side effects:
  1069.  *    Whatever the system call would normally do.
  1070.  *
  1071.  * NOTE:
  1072.  *    This should be the last page of this file, since it undefines
  1073.  *    the macros that redirect read etc. to the procedures below.
  1074.  *
  1075.  *----------------------------------------------------------------------
  1076.  */
  1077.  
  1078. #undef open
  1079. int
  1080. TclOpen(path, oflag, mode)
  1081.     char *path;
  1082.     int oflag;
  1083.     int mode;
  1084. {
  1085.     int result;
  1086.     while (1) {
  1087.     result = open(path, oflag, mode);
  1088.     if ((result != -1) || (errno != EINTR)) {
  1089.         return result;
  1090.     }
  1091.     }
  1092. }
  1093.  
  1094. #undef read
  1095. int
  1096. TclRead(fd, buf, numBytes)
  1097.     int fd;
  1098.     char *buf;
  1099.     size_t numBytes;
  1100. {
  1101.     int result;
  1102.     while (1) {
  1103.     result = read(fd, buf, (size_t) numBytes);
  1104.     if ((result != -1) || (errno != EINTR)) {
  1105.         return result;
  1106.     }
  1107.     }
  1108. }
  1109.  
  1110. #undef waitpid
  1111. extern pid_t waitpid _ANSI_ARGS_((pid_t pid, int *stat_loc, int options));
  1112. int
  1113. TclWaitpid(pid, statPtr, options)
  1114.     pid_t pid;
  1115.     int *statPtr;
  1116.     int options;
  1117. {
  1118.     int result;
  1119.     while (1) {
  1120.     result = waitpid(pid, statPtr, options);
  1121.     if ((result != -1) || (errno != EINTR)) {
  1122.         return result;
  1123.     }
  1124.     }
  1125. }
  1126.  
  1127. #undef write
  1128. int
  1129. TclWrite(fd, buf, numBytes)
  1130.     int fd;
  1131.     char *buf;
  1132.     size_t numBytes;
  1133. {
  1134.     int result;
  1135.     while (1) {
  1136.     result = write(fd, buf, (size_t) numBytes);
  1137.     if ((result != -1) || (errno != EINTR)) {
  1138.         return result;
  1139.     }
  1140.     }
  1141. }
  1142.